home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / encorsrc.lha / encore_sources / sys / unvaxkernel.t < prev    next >
Text File  |  1988-05-02  |  15KB  |  370 lines
  1. (herald unvaxkernel (env tsys))
  2.  
  3. ;;; Copyright (c) 1985 Yale University
  4. ;;;     Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
  5. ;;; This material was developed by the T Project at the Yale University Computer 
  6. ;;; Science Department.  Permission to copy this software, to redistribute it, 
  7. ;;; and to use it for any purpose is granted, subject to the following restric-
  8. ;;; tions and understandings.
  9. ;;; 1. Any copy made of this software must include this copyright notice in full.
  10. ;;; 2. Users of this software agree to make their best efforts (a) to return
  11. ;;;    to the T Project at Yale any improvements or extensions that they make,
  12. ;;;    so that these may be included in future releases; and (b) to inform
  13. ;;;    the T Project of noteworthy uses of this software.
  14. ;;; 3. All materials developed as a consequence of the use of this software
  15. ;;;    shall duly acknowledge such use, in accordance with the usual standards
  16. ;;;    of acknowledging credit in academic research.
  17. ;;; 4. Yale has made no warrantee or representation that the operation of
  18. ;;;    this software will be error-free, and Yale is under no obligation to
  19. ;;;    provide any services, by way of maintenance, update, or otherwise.
  20. ;;; 5. In conjunction with products arising from the use of this material,
  21. ;;;    there shall be no use of the name of the Yale University nor of any
  22. ;;;    adaptation thereof in any advertising, promotional, or sales literature
  23. ;;;    without prior written consent from Yale in each case.
  24. ;;;
  25.  
  26. ;;; The procedure big_bang MUST come first in this file.
  27. ;;; BIG_BANG is called to instantiate the root process of an external
  28. ;;; T image. It is called by a foreign stub program with arguments
  29. ;;; as follows:
  30. ;;;
  31. ;;;  (BIG_BANG memory mem-size argc argv bsd4.2?).
  32. ;;;
  33. ;;; The argument vector is saved as a T vector in *BOOT-ARGS*.  The
  34. ;;; Xenoids are created for STDIN and STDOUT and placed in the 2nd
  35. ;;; and 3rd argument registers.  The global-constant register (NIL)
  36. ;;; and the task register are initialized, and the root process
  37. ;;; block is created and initialized.  The stack is initialized.
  38. ;;; The heap-pointer and heap-limit of the root process are
  39. ;;; initialized.  Finally the address of the T procedure BOOT is
  40. ;;; placed in them P (procedure) register, and we jump through the
  41. ;;; root process block to ICALL.  Boot is called as follows:
  42. ;;;
  43. ;;;     (BOOT root-task boot-args),
  44.  
  45. ;;; Unresolved issues:
  46. ;;; - Is the arg vector the right size and is the descriptor correct?
  47. ;;; - What should the initial stack size be and how can you tell?
  48. ;;; - The stack and areas should have guards - later I  guess
  49. ;;; - how to boot other systems
  50. ;;; - stdio shit?
  51. ;;; - PID as Fixnum?
  52. ;;; - *the-slink*
  53. ;;; - test stack-overflow in icall?
  54. ;;; - heap overflow code
  55. ;;; - exception code
  56. ;;; - interrupt code
  57.  
  58.  
  59. ;;;  When we enter Big_bang the stack looks as follows:
  60. ;;;
  61. ;;;              |      debug?   |
  62. ;;;              |_______________|
  63. ;;;              |      argv     |    Command line argv
  64. ;;;              |_______________|
  65. ;;;              |      argc     |    Command line argc
  66. ;;;              |_______________|
  67. ;;;              |  heap-size    |  
  68. ;;;              |_______________|
  69. ;;;              |     heap2     | 
  70. ;;;              |_______________|  
  71. ;;;              |     heap1     |
  72. ;;;              |_______________|
  73. ;;;       SP =>  |          | N  |    ensured by unvax_start_t.s
  74. ;;;              |__________|____|
  75. ;;;              |    header     |  <= *boot-args*
  76. ;;;              |_______________|
  77.  
  78. (define (big_bang)
  79.   (lap (*boot* *the-slink* vax-big-bang)
  80.  
  81.     ;; set up global-constants
  82.     (movl  (d@r P (static '*the-slink*)) nil-reg)
  83.     (movl (d@r nil-reg 2) nil-reg)
  84.     (ashl ($ 2) s0 s0)
  85.     (movl  S0 (d@r nil-reg slink/interrupt-handler))    ; interrupt_xenoid
  86.     (movl SP A1)  ; save argument pointer        
  87.                   ; we have 6 *boot-args*
  88.     (pushl ($ (fx+ (fixnum-ashl 6 8) header/general-vector)))
  89.     (moval (d@r SP 2) A2)              ; 2nd arg to boot
  90.     (movl A2 (d@r nil-reg slink/boot-args))    ; we have 6 boot-args
  91.  
  92.     (movl (d@r P (static 'vax-big-bang)) P)
  93.     (movl (d@r p 2) p)
  94.     (movl (d@r P -2) A2)
  95.     (moval (label big-bang-return) TP)
  96. ;;; note that pointer to boot args in A1
  97.     (jmp (@r A2))                  
  98. big-bang-return
  99.  
  100.     ;; initialize area, area-frontier, and area-limit
  101.     (movl  (d@r A1 4) S0)                       ; move addr heap
  102.     (movl  S0 (d@r TASK task/area-begin))      
  103.     (movl  S0 (d@r TASK task/area-frontier))         
  104.     (addl3 (d@r A1 12) S0 (d@r TASK task/area-limit))
  105.  
  106.     ;; Set up the procedure register P and call boot,
  107.     ;; never to return. (note: args 2 was setup above)
  108.     (movl nil-reg A3)
  109.     (tstl (d@r A1 24))                             ;check for debug switch
  110.     (beql (to %debug))
  111.     (movl ($ header/true) A3)
  112. %debug
  113.     (moval (d@r TASK %%task-header-offset) A1)     ; root-process
  114.     (movl  ($ 4) NARGS)                            ; 2 args
  115.     (movl  (d@r P (static '*boot*)) P)
  116.     (movl (d@r p 2) p)
  117.     (movl  (d@r P -2) TP)
  118.     (jmp   (@r TP))))
  119.  
  120. (define (call-fault-handler)
  121.   (lap (signal-handler)
  122.  
  123.     (equate t-interrupt                   (fixnum-ashl 2 2))
  124.     (equate t-virtual-timer               (fixnum-ashl 26 2))
  125.  
  126.     (movl ($ t-interrupt) A1)
  127.     (bitb ($ 2) (d@r TASK (fx+ task/critical-count 3)))
  128.     (jn= %call-fault)
  129.     (movl ($ t-virtual-timer) A1)
  130. %call-fault                                
  131.     (moval (d@r SP 6) A2)
  132.     (movl (d@r P (static 'signal-handler)) P)
  133.     (movl (d@r p 2) p)
  134.     (movl (d@r P -2) TP)
  135.     (movb ($ 0) (d@r TASK (fx+ task/critical-count 3)))
  136.     (jmp (@r TP))))                                
  137.  
  138.  
  139. ;;;; Low-level exception handling
  140.  
  141. (lap-template (0 0 -1 t stack %fault-frame-handler)
  142. %fault-frame-template
  143.     (bisb2 ($ #b01000000) (d@r task (fx+ task/critical-count 3)))
  144.     (ashl ($ -8) (d@r SP 4) S0)                    ; fault header
  145.     (addl2 ($ 2) S0)                          ; 2 for header and template
  146.     (tstl (d@r SP 12))
  147.     (j= foobar)
  148.     (movl (d@r SP 12) (index (@r SP) S0))   ; restore hacked top of stack
  149. foobar
  150.     (addl2 ($ 16) sp)        ; pop template,header,pointers on stack,hack top
  151.     (movl (d@r SP (* (+ *pointer-temps* *scratch-temps* 10) 4))
  152.              A1)                           ; context
  153.     (movl (@r+ SP) (d@r A1 %%df_pc))
  154.     (movl (@r+ SP) (d@r A1 %%df_r4))    ; P
  155.     (movl (@r+ SP) (d@r A1 %%df_r5))    ; A1
  156.     (movl (@r+ SP) (d@r A1 %%df_r6))    ; A2
  157.     (movl (@r+ SP) (d@r A1 %%df_r7))    ; A3
  158.     (movl (@r+ SP) (d@r A1 %%df_r8))    ; A4
  159.     (movl (@r+ SP) (d@r A1 %%df_r9))    ; AN
  160.     (movl (@r+ SP) (d@r A1 %%df_r10))    ; TP
  161.  
  162.     (movl ($ -2) S0)
  163. %fault-restore-loop                                  ; restore temps
  164.     (movl (@r+ SP) (index (@r TASK) S0))
  165.     (incl S0)
  166.     (cmpl ($ (fx/ temp-block-size 4)) S0)          
  167.     (j> %fault-restore-loop)
  168.     (addl2 ($ 4) SP)                           ; pop context
  169.     (bicb2 ($ #b01000000) (d@r task (fx+ task/critical-count 3)))
  170.     (rsb)
  171. %fault-frame-handler
  172.     (movl nil-reg an)
  173.     (rsb))
  174.  
  175. (lap-template (0 0 -1 nil stack handle-foreign-return)
  176. %foreign-return
  177.     (bisb2 ($ #b01000000) (d@r task (fx+ task/critical-count 3)))
  178.     (addl2 ($ 8) sp)                         ; pop template,header
  179.     (movl (@r+ SP) (d@r TASK task/foreign-call-cont))
  180.     (bicb2 ($ #b01000000) (d@r task (fx+ task/critical-count 3)))
  181.     (rsb)
  182. handle-foreign-return
  183.     (movl nil-reg AN)
  184.     (rsb))
  185.                  
  186.  
  187. (lap-template (0 0 -1 nil stack handle-enable-return)
  188. %re-enabled
  189.     (addl2 ($ 4) sp)                         ; pop return address
  190.     (rsb)
  191. handle-enable-return
  192.     (movl nil-reg AN)
  193.     (rsb))
  194.  
  195. (lap-template (0 0 -1 nil stack handle-doing-gc-return)
  196. %doing-gc-return
  197.     (addl2 ($ 4) sp)                         ; pop return address
  198.     (rsb)
  199. handle-doing-gc-return
  200.     (movl nil-reg AN)
  201.     (rsb))
  202.  
  203. ;;; Interrupts can be deferred.   
  204. ;;; the task/critical count byte has
  205. ;;; bit 7 -- interrupts deferred
  206. ;;; bit 6 -- interrupts ignored
  207. ;;; bit 1 -- quit pending
  208. ;;; bit 0 -- timer interrupt pending
  209.         
  210. (define (interrupt_dispatcher)       ; arg pointer is AN
  211.   (lap (signal-handler enable-signals gc_interrupt)
  212.  
  213.     (equate %%fault-sp-offset 8)
  214.     (equate %%df_r4       -36)                    ; P
  215.     (equate %%df_r5       -32)                    : a1
  216.     (equate %%df_r6       -112)                   ; a2
  217.     (equate %%df_r7       -108)                   ; a3
  218.     (equate %%df_r8       -104)                   ; a4
  219.     (equate %%df_r9       -100)                   ; an
  220.     (equate %%df_r10       -96)                   ; tp
  221.     (equate %%df_pc       12)
  222.     (equate fault-quit      3)
  223.     (equate fault-interrupt                   2)
  224.     (equate fault-virtual-timer               26)
  225.                                              
  226.     (movl (d@r AN 4) A4)                       ; get signal code
  227.     (movl (d@r nil-reg slink/current-task) task)    ; restore task
  228.     (bbs ($ 6) (d@r task (fx+ task/critical-count 3)) (to %ignore-interrupt))
  229.     (movl (d@r AN 12) AN)                      ; get context
  230.     (cmpl ($ fault-virtual-timer) A4)             ; is this a timer interrupt?
  231.     (j= %timer)                                   
  232.     (cmpl ($ fault-interrupt) A4)                   ; is this a ^q?
  233.     (jn= %fault)                                  ; if so ..
  234.     (cmpl (d@r TASK task/doing-gc?) nil-reg)    ; are we doing gc?
  235.     (jn= %doing-gc)                               ; if not ...
  236.     (tstl (d@r TASK task/foreign-call-cont))
  237.     (jn= %fault)
  238.     (bitb ($ 2) (d@r TASK (fx+ task/critical-count 3)))   ; is this the second one?                
  239.     (j= %set-interrupt-flag)                      ; if not, defer interrupt
  240.     (bicb2 ($ 2) (d@r TASK (fx+ task/critical-count 3)))
  241.     (tstb (d@r TASK (fx+ task/critical-count 3)))       ; are interrupts deferred?
  242.     (j= %fault)                                   ; if so ...
  243. %set-interrupt-flag    
  244.     (bisb2 ($ 2) (d@r TASK (fx+ task/critical-count 3)))  ; set quit bit 
  245.     (jmp (label %ignore-interrupt))
  246. %timer
  247.     (cmpl (d@r TASK task/doing-gc?) nil-reg)    ; are we doing gc?
  248.     (jn= %ignore-interrupt)
  249.     (tstb (d@r TASK (fx+ task/critical-count 3)))
  250.     (j= %fault) 
  251.     (bisb2 ($ 1) (d@r TASK (fx+ task/critical-count 3)))  ; set timer bit 
  252. %ignore-interrupt 
  253.     (pushal (label %re-enabled))                     ; re-enable interrupts
  254.     (movl (d@r p (static 'enable-signals)) p)    ; DON'T CONS!!!
  255.     (movl (d@r p 2) p)
  256.     (movl (d@r p -2) tp)
  257.     (jmp (@r tp))                                                       
  258.  
  259. %doing-gc
  260.     (pushal (label %doing-gc-return))
  261.     (movl (d@r p (static 'gc_interrupt)) p)
  262.     (movl (d@r p 2) p)
  263.     (movl (d@r p -2) tp)
  264.     (jmp (@r tp))                                                       
  265.  
  266.  
  267. ;;; Interrupts should be disabled here.
  268. %fault
  269.     (movl (d@r task task/foreign-call-cont) S1)
  270.     (j=  %t-code-interrupt)
  271.  
  272.     ;; Interrupted out of foreign code.
  273.     (clrl (d@r task task/foreign-call-cont))     
  274.     (pushl s1)                       ; push foreign continuation
  275.     (subl2 sp s1)                   ; compute frame size
  276.     (ashl ($ 6) S1 S1)
  277.     (movb ($ (fx+ header/fault-frame 128)) S1)
  278.     (pushl s1)                      ; push frame size 
  279.     (pushal (label %foreign-return))
  280.     (jmp (label %fault-done))
  281.                                  
  282. ;;; registers s0=fault-sp  aN=context                                   
  283. %t-code-interrupt                    
  284.     (pushl AN)                  ; save context
  285.     (movl (d@r AN %%fault-sp-offset) S0)        ; get fault SP in S0
  286.     (movl S0 A1)                        ; save fault sp
  287.  
  288.     (movl ($ (fx/ (fx+ temp-block-size 4) 4)) S2)
  289. %fault-save-loop                              ; save temps and extra p and s
  290.     (pushl (index (d@r TASK -8) S2))
  291.     (decl S2)
  292.     (j>= %fault-save-loop)
  293.                                                                          
  294.     (pushl (d@r AN %%df_r10)) ; TP
  295.     (pushl (d@r AN %%df_r9)) ; AN
  296.     (pushl (d@r AN %%df_r8)) ; A4
  297.     (pushl (d@r AN %%df_r7)) ; A3
  298.     (pushl (d@r AN %%df_r9)) ; A2
  299.     (pushl (d@r AN %%df_r5)) ; A1
  300.     (pushl (d@r AN %%df_r4)) ; P
  301.     (movl (d@r AN %%df_pc) S1)
  302.     (pushl S1) 
  303.     (cmpl (d@r nil-reg slink/kernel-begin) S1)
  304.     (j> %not-in-kernel)
  305.     (cmpl (d@r nil-reg slink/kernel-end) S1)
  306.     (j< %not-in-kernel)
  307.     (pushl (@r A1))              ; save hack top of stack
  308.     (pushl ($ 0))                      ; no pointers on top
  309.     (jmp (label %t-code-done))
  310.  
  311. %not-in-kernel
  312.     (pushl ($ 0))                      ; no hacked stack top
  313.  
  314. ;;; find how many pointers on top of stack
  315.     (mnegl ($ 1) s1)                    ; pointer slot counter as fixnum
  316.  
  317. %find-last-template-loop
  318.     (incl s1)                      ; incr # pointer counter
  319.     (movl (@r+ a1) s2)                  ; load next word
  320.     (cmpb ($ header/vframe) s2)          ; vframe?
  321.     (j= %found-frame)                         ; .. if so, done looking
  322.  
  323.     (bicb3 ($ #b11111100) s2 s3)                        ; copy for extend test
  324.     (cmpb ($ tag/extend) s3)             ; extend?
  325.     (jn=  %find-last-template-loop)        ; .. if not, keep looking
  326.     (cmpb ($ header/template) (d@r s2 -2))               ; fetch template 
  327.     (jn= %find-last-template-loop)        ; .. if high bit is 0, keep looking
  328.  
  329. %found-frame
  330.     (ashl ($ 2) s1 (@-r SP))                  ; push number of pointers on stack
  331. %t-code-done
  332.     (subl2 sp s0)                         ; compute total size of frame
  333.     (ashl ($ 6) s0 s0)
  334.     (movb ($ header/fault-frame) s0)
  335.     (pushl s0)                  ; push fault header
  336.     (pushal (label %fault-frame-template))         ; call fault handler
  337.  
  338. %fault-done                                            
  339.     (ashl ($ 2) A4 a1)                        ; 1st argument is signal code
  340.     (moval (d@r SP 6) a2)                         ; 2nd argument is frame
  341.     (movl (d@r p (static 'signal-handler)) p)   ; ...
  342.     (movl (d@r p 2) p)
  343.     (movl (d@r p -2) tp)                     ; ...
  344.     (jmp (@r tp))                               ; ...
  345.  
  346.     ))                           
  347.  
  348. (define (local-machine)
  349.   (object nil                               
  350.       ((machine-type self)          'vax/unix)
  351.       ((machine-suspend-file self)  '(link unvaxsuspend))
  352.       ((page-size self)             512)
  353.       ((object-file-type self)      'vo)
  354.       ((information-file-type self) 'vi)
  355.       ((noise-file-type self)       'vn)
  356.       ((print-type-string self)     "Machine")))
  357.  
  358. (define (nan? x) (ignore x) '#f)
  359.  
  360. (define (st_mtime stat-block)
  361.   (+ (ash (mref-16-u stat-block 34) 16) 
  362.      (mref-16-u stat-block 32)))
  363.  
  364. (define-integrable (st_size stat-block)
  365.   (mref-integer stat-block 20))
  366.  
  367.  
  368. (define-integrable (st_mode stat-block)
  369.   (mref-16-u stat-block 8))
  370.